D-A032  739 


UNCLASSIFIED 


SOUTHEASTERN  MASSACHUSETTS  UNIV  NORTH  DARTMOUTH  DEPT  —ETC  F/G  9/2 
A NEW  SOFTWARE  PACKAGE  FOR  SEISMIC  AND  IMAGERY  RECOGNITION. (U) 

SEP  76  C H CHEN  AF-AFOSR-2951-76 


EE-76-4 


AFOSR-TR-76-1166 


TECHNICAL  REPORT  SERIES  IN  INFORMATION  SCIENCES 
(Dr.  C.  H.  Chen,  Principal  Investigator) 


nssa  CHUs 


SOUTHEASTERN  MASSACHUSETTS 

UNIVERSITY 

ELECTRICAL  ENGINEERING  DEPARTMENT 


Approve-.*  for  i.  reieas# 
distribution  unlimited. 


NORTH  DARTMOUTH,  MASS.  02747  U.S.A 


Grant  AFOSR  76-2951 
TR  No.  EE-76-1* 
September  7,  1976 


AFOSR  - TR  - 7 6 - 1 1 6 6 


A NEW  SOFTWARE  PACKAGE 
FOR  SEISMIC  AND  IMAGERY  RECOGNITION 


by 

C.  H.  Chen 

Electrical  Engineering  Department 
Southeastern  Massachusetts  University 
North  Dartmouth,  Massachusetts  0271*7 


Abstract 


This  report  summarizes  the  software  development 
pattern  recognition  studies  under  the  support  of  the 
and  major  program  listings  are  described  in  detail, 
based  on  PDP  11-1*5  minicomputer  and  display  units  is 
of  the  software  package  described.  Furthermore,  all 
listed  have  provided  excellent  recognition  results. 


effort  on  seismic  and  imagery 
Grant.  The  program  libraries 
The  complete  recognition  system 
truly  interactive  with  the  aid 
algorithms  of  the  programs 


A New  Software  Package  for  Seismic  and  Imagery  Recognition 

C.  H.  Chen 


I.  Introduction 

This  report  provides  a most  up-to-date  description  of  computer  programs 
on  teleseismic  pattern  recognition  and  imagery  pattern  recognition  studies 
which  have  been  carried  out  in  this  research  group  under  the  support  of  grant 
from  the  Directorate  of  Mathematical  and  Information  Sciences,  Air  Force 
Office  of  Scientific  Research.  Documentation  of  the  software  on  seismic 
recognition  research  was  made  over  two  years  ago  (l).  A considerable  change 
in  the  programs  has  been  made  since  then.  The  present  report  includes  both 
seismic  and  imagery  programs  which  are  written  in  more  efficient  manner  although 
the  programming  language  is  still  Fortran.  In  every  pattern  recognition  research 
group  throughout  the  world,  nearly  one-half  of  the  research  effort  has  to  be 
devoted  to  the  software  development.  To  unify  and  thus  simplify  such  effort 
is  impossible  because  each  group  has  its  own  computer  facility  and  would  prefer 
to  use  its  own  algorithms.  However,  by  documenting  a software  package  as  this 
report,  other  groups  with  similar  computer  facilities  may  not  have  to  duplicate 
the  extensive  programming  effort  if  the  same  algorithms  are  used.  All  algorithms 
presented  in  this  report  have  provided  good  recognition  results.  Our  computer 
recognition  system,  the  PDP  11-1*5  along  with  display  units,  ar.d  the  x'ortran 
language  used  are  both  quite  typical  throughout  the  world.  Thus  we  believe 
this  report  will  definitely  provide  a useful  service  to  the  pattern  recognition 
research  community. 


(l)  C.  H.  Chen  and  I.  C.  Lin,  "A  Summary  of  PDP  11-1*5  computer  software 
package  for  seismic  data  analysis  and  discrimination",  DECUS  Proceedings, 
Boston,  May  197**. 
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II.  Program  Directory  and  Library 

In  the  following  pages  1b  a list  of  typical  program  directory  under 
different  user  numbers.  The  directory  Includes  the  names  of  all  computer 
programs  for  both  seismic  and  image  studies.  The  directory  may  change  from 
time  to  time.  However  there  are  some  programs  which  are  sued  very  often  and 
should  be  better  protected.  They  can  be  placed  in  the  program  libraries. 

The  Fortran  library  comes  with  the  computer  system  and  is  eeifential  to  link 
any  Fortran  program.  The  list  of  other  libraries  particularly  useful  for  the 
recognition  studies  is  provided  in  the  following  pages.  This  includes:  SPS 

Library  and  SSP  Library  for  basic  recognition  operations;  TCS  Library  for  the 
Technonix  keyboard  screen  display;  XY  Library  and  GT  Library  for  interface 
with  XY  plotter  and  GT  Uo  display  terminal  respectively. 
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DIRECTORY  DKO:  C 30. 1 3 

30- AUG- 76 


List  of  Names  of  Programs 
Stored  in  the  Disk 
(continued  next  page) 


I 


I 


CMPX 

1 

SPIKE3 

3 

FFT1 

2 

C2 

2 

ATO 

DDT 

80C 

DFT5 

2 

AUT01 

2 

FFT3 

2 

C8 

3 

HSGRAM 

1 

C0CN2 

1 

ATO 

DAT 

41C 

PLOT 



1 

STST 

1 

AT02 

1 

CuCNl 

2 

BIST 

2 

DIST2 

1 

CMX 

DAT 

18C 

C5 

3 

TEST 

1 

ATI 

DAT 

3C 

POINT 

1 

TEST2 

2 

FFT 

DAT 

5C 

COMPAR 

1 

DFT4 

3 

SPIKE1 

3 

CLASO 

2 

ATO 

1 

SPIKE 

3 

SI 

1 

SHOW 

2 

TEST  1 

2 

EAQ 

EXP 

2C 

TEST4 

1 

FFT4 

3 

C4 

3 

LEVEL 

2 

DIST1  . 

LDA 

18 

AT01 

1 

TEST5 

1 

S2 

1 

DIST1 

1 

SPIKE2 

3 

COCNO 

4 

Ac  1 

1 

MEAN 

3 

FFT5 

3 

D2M 

1 

C7 

3 

C6 

2 

CIO 

2 

CLAS3 

3 

TTST 

1 

CLAS1 

2 

PLOTS 

2 

22—  APR— 72  <233> 
25— JAN— 72  <233> 

1 7-MAY— 72  <233> 
07— MAR-72  <233> 
06-MAR— 72  <233> 
06-FEB-72  <233> 
06-MAR-72  <233> 

17- MAY-72  <233> 

16- MAR-72  <233> 

30-  JAN- 72  <233> 

18- FEB-72  <233> 

31 - MAR-72  <233> 
13-MAY— 72  <233> 
06-APR— 72  <233> 

06- MAR-72  <233> 
05-FEB-72  <2 33> 

1 7- MAY-72  <233> 
1 7-MAY-72  <233> 

15- APR-72  <233> 

16- MAR-72  <233> 

23-  JAN-72  <233> 
28-MAR-72  <233> 

07- MAR-72  <233> 

24-  JAN-72  <233> 
1 3-MAR-72  <233> 

25—  JAN-72  <233> 
31-JAN-72  <233> 
25- JAN- 72  <23 3> 

1 7- MAY-72  <233> 
1 7-MAY-72  <233> 
25- JAN-72  <233> 
31 -JAN-72  <233> 

12- MAR-72  <233> 

23- JAN-72  <233> 
02- JAN-72  <233> 

27- MAR— 72  <233> 
15-APR-72  <233> 
07-MAR-72  <233> 
04-FEB-72  <233> 
11 -MAY-72  <233> 
1 7-MAY-72  <233> 
07-MAR-72  <233> 
25- JAN- 72  <233> 
1 7-MAY— 72  <233> 
25- JAN-72  <233> 
04-FEB-72  <233> 

28- MAR-72  <233> 
25- JAN-72  <233> 

19-  APR- 72  <233> 
25— JAN— 72  <233> 
23— MAR-72  <233> 
11 -MAR-72  <233> 
23-MAR— 72  <233> 
04-APR-72  <233> 

13- MAR-72  <233> 
1 7— MAY-72  <233> 
23-APR-72  <233> 


HAMING 

1 

MAIN 

2 

SH0W1 

1 

TABLE 

2 

C9 

3 

HST 

1 

CLASO  . 

LDA 

23 

TEST6 

1 

PROJT  . 

OBJ 

14 

P3 

3 

FFT 

3 

M2D 

1 

C0C14 

1 

PROJT 

3 

ATC 

DAT 

3C 

FT3 

DAT 

SC 

MAIN2 

1 

FT  1 

DAT 

6C 

CLAS4 

3 

PLOT  1 

2 

MAIN1 

1 

AC 

1 

CA 

2 

CLAS1  . 

LDA 

23 

PL0T2 

2 

PL0T6 

1 

PG2 

DAT 

2C 

FT2 

DAT 

41C 

CLAS4  . 

LDA 

24 

POINT 1 

1 

PLOT  3 

1 

QX1 

DAT 

816C 

EPLID 

2 

MAG 

DPH 

6C 

TEST3 

1 

C0PY3 

2 

TST 

1 

PL0T7 

1 

TTT 

1 

SMP 

DAT 

1C 

PL0T4 

1 

CLAS2 

3 

PQ3 

DAT 

2C 

SPP 

1 

CLASS 

3 

17- MAY- 72  <233> 

27- MAR-72  <233> 
1 3— MAR— 72  <233> 
04-FEB— 72  C233> 
11 -MAR-72  <233> 
04-FEB-72  <233> 
11 -MAY-72  <23 3> 
07— MAR-72  <233> 
23-APR— 72  <233> 
04-FEB-72  <233> 

28- MAR-72  <233> 

04- FEB-72  <233> 

05- FEB-72  <233> 
23-APR- 72  <233> 
23-MAR-72  <233> 
16-APR-72  <233> 
07-MAR-72  <233> 
28— MAR- 72  <233> 
11 -MAY-72  <233> 

23- MAR-72  <233> 

28- MAR-72  <233> 

24- MAR-72  <233> 
30-MAR-7 2 <233> 
1 1 -MAY- 7 2 <233> 

23-  APR- 72  <233> 

29- MAR-72  <233> 
28-MAR-72  <233.> 
04-APR— 72  <233> 
11 -MAY-72  <233> 
28-MAR-72  <233> 

28- MAR-72  <233> 
16-APR-72  <233> 

25- MAR-72  <233> 
27-MAR-72  <233> 
2 7 -MAR- 72  <233> 

29- MAR-72  <233> 
15- APR- 72  <233> 

29-MAR-72  <233> 

06-  APR-72  <233> 
01 -APR-72  <233> 

24—  APR-72  <233> 
21 -APR-72  <233> 

18-  APR- 72  <233> 

18- APR-72  <233> 

19- APR— 72  <233> 


TOTL  BLKS:  1284 

lOTL  FILES:  102 


T 


i'*  - 1 IKS  - 
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XYGRD5 

3 

1 7— MAY-72 

<233> 

MAIN1 

2 

28-MAR-72 

<233> 

SEE2 

2 

22-MAY-72 

<233> 

HGUGH2 

2 

OS-MAY-72 

<233> 

X YP3 

3 

28-MAR-72 

<233> 

TEM  . TEM 

256C 

24-MAY-72 

<233> 

MAIN 

3 

28-MAR-72 

<233> 

HOUGH 1 

2 

08— MAY— 72 

<233> 

HAMING 

3 

28-MAR-72 

<233> 

SEE2  . LDA 

18 

07— MAY— 72 

<233> 

HUUGHO 

2 

26-APR-72 

<233> 

TMP  . DAT 

113C 

07-MAY— 72 

<233> 

TEST4 

1 

23-MAY-72 

<233> 

XYP1 

2 

28-MAR-72 

<233> 

HGH1 

3 

24-MAY-72 

<233> 

GRAD1 

1 

25-MAY-72 

<233> 

1 SMI 

2 

28-MAR— 72 

<233> 

DIN2 

1 

24-MAY-72 

<233> 

XYP2 

2 

28-MAR-72 

<233> 

MIDL 

2 

07-MAY-72 

<233> 

DPT  1 

3 

28-MAR— 72 

<233> 

XYTS 

2 

23-MAR-72 

<233> 

MAIN4 

3 

28-MAR-72 

<233> 

MIDL  .LDA 

15 

07-MAY-72 

<233> 

XYHT 

5 

23-MAR- 72 

<233> 

D2M1 

2 

28-MAR-72 

<233> 

DAT  . DAT 

256C 

26-APR-72 

<233> 

COPY 

2 

13-MAY-72 

<233> 

D2M 

2 

28-MAR-72 

<233> 

SEE4 

1 

24-MAY-72 

<233> 

HOUGH3 

2 

24-MAY-72 

<233> 

HOUGHS 

3 

24-MAY— 72 

<233> 

HGH  . DAT 

57C 

27-APR-72 

<233> 

COPY  . OBJ 

8 

26-MAY-72 

<233> 

SEE1 

1 

24-MAY-72 

<233> 

SEE  . LDA 

17 

24-MAY— 72 

<233> 

HGH2 

1 

24-MAY-72 

<233> 

DOUT 

1 

27-APR-72 

<233> 

HGH2  . LDA 

17 

24-MAY-72 

<233> 

GRAD  * LDA 

20 

06-APR-72 

<233> 

DIN  . LDA 

20 

2 1 -MAY-72 

<233> 

DIN 

1 

24-MAY-72 

<233> 

TEST4  . LDA 

18 

23-MAY-72 

<233> 

HCKJGH4.  LDA 

23 

22-MAY— 72 

<233> 

TTSS 

1 

06-MAY-72 

<233> 

DIN1 

1 

24-MAY- 72 

<2333 

H0UGH3.  LDA 

22 

27-APR-72 

<23 3> 

TMP  . TMP 

57C 

28-APR-72 

<233> 

XYGRD5.  LDA 

32 

16-MAY-72 

<233> 

XYGRD4 

3 

1 6— MAY— 72 

<233> 

XYGRD6 

3 

13-MAY-72 

<233> 

XYGRD6.  LDA 

29 

13-MAY-72 

<233> 

XYGRD3 

3 

1 3-MAY-72 

<233> 

TTSS  . LDA 

17 

06-MAY- 72 

<233> 

SE£1  . LDA 

18 

24-MAY— 72 

<233> 

XYGRD7 

3 

15-MAY-72 

<233> 

XYGRD2 

2 

06— MAY— 72 

<233> 

DIN2  . LDA 

12 

24-MAY-72 

C233> 

GRAD2  . LDA 

20 

25-MAY-72 

<233> 

HGH3  . LDA 

21 

24-MAY-72 

<233> 

XYUHD 

2 

06-MAY-72 

<2333 

GRAD3  1 


HUH3 

1 

XYGRD9 

4 

HUT 

2 

TEST  1 

1 

HST 1 

l 

TEST 

A 

1 

D1N3 

1 

GKAD2 

2 

HuH4 

1 

D1N1  . LDA 

21 

-DIN3  .LDA 

11 

XYGRD3 

3 

GRAD 

2 

HUH4  . LDA 

21 

TEST2 

1 

SEE3 

2 

X YGRD1 

3 

TEST3 

1 

TEM  . DAT 

64C 

XYGRD1.  LDA 

24 

GRADO 

1 

SEE 

1 

SEE3  . LDA 

20 

SEE4  . LDA 

17 

HST2 

1 

HGUGH4 

2 

HST 2 . LDA 

24 

HOH0 

2 

HOHO  . LDA 

23 

GRAD3  . LDA 

18 

GRADO  . LDA 

18 

TOTL  BLKS: 

1444 

TUTL  FILES 

93 

DIRECTORY 

DKO:  C 
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25— MAY— 72  <233> 
24-MAY-72  <233> 
15-MAY— 72  <233 > 
06-MAY-72  <233> 

23-MAY-72  <233> 
06-MAY-72  <233> 

23- MAY-72  <233> 

24- MAY-72  <233> 

25- MAY— 72  <233> 

24— MAY-72  <233> 
24-MAY-72  <233> 
24— MAY— 72  <233> 
06-MAY— 72  <233> 
06-APR-72  <233> 
24-MAY-72  <233> 

23- MAY-72  <233> 

24- MAY-72  <233> 
06-APR-72  <233> 

23—  MAY-72  <233> 

24—  MAY-72  <233> 
06- APR- 72  <233> 

25— MAY-72  <233> 
24— MAY-72  <233> 
24- MAY-72  <233> 
24- MAY-72  <233> 
24-MAY-72  <233> 
24-MAY-72  <233> 
24- MAY- 72  <233> 
24— MAY-72  <233> 

24- MAY-72  <233> 

25—  MAY-72  <233> 
25-MAY- 72  <233> 


1.  I 3 


- BADB  . SYS 
MuNLIB.  CIL 

1 

175C 

14— APR— 70 
27-MAR— 7 1 

<377> 

<377> 

PIP  . LDA 

35C 

26-MAR— 7 1 

<233> 

FuRTRN.  LDA 

34 

28-MAR— 7 1 

<233> 

XYLIB  . OBJ 

18 

06-MAY— 72 

<233> 

SRSLIB  OBJ 

38 

23-MAY-72 

<233> 

VERIFY.  LDA 

68C 

27-MAR-7 1 

<233> 

MACRO  . LDA 

40C 

27-MAR-71 

<233> 

LINK  . LDA 

68C 

27-MAR-7 1 

<233> 

SKIP  . LDA 

4 

22-MAY-71 

<233> 

EDIT  . LDA 

14 

27-MAR-7 1 

<233> 

SSSLIB  OBJ 

1 

25-MAY-72 

<233> 

SoPLIB.  OBJ 

151 

25-MAY-72 

<000> 

LIBR  . LDA 

10 

27-MAR-7 1 

<233> 

TRCLIB.  OBJ 

13 

28-MAR-71 

<233> 

F TNLIB.  OBJ 

170 

27-MAR-71 

<233> 

SYSMAC.  SML 

27 

28-MAR— 7 1 

<233> 

FuRTRN  OVR 

119C 

28-MAR-7 1 

<233> 

-FGRRUN.  DGN 

16C 

28— MAR— 71 

<233> 

FURCOM.  DGN 

21C 

28-MAR— 71 

<233> 

TCSLIB  OBJ 

1*4 

21 -MAY-71 

<233> 

GTLIB  . OBJ 

21 

21 -MAY-71 

<2333 

TOTL  BLKS: 

1188 

TuTL  FILES: 

- •••  »-•»  • 

22 
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LIBR  V05A  LIBR  V05A 

SPSLIB.  OBJ  28— AUG— 76  SSPLIB.  OBJ  24-AUG-76 

SEQ  NAME  VERSION  - SEQ.  NAME  VERSION 


OOOOl  SPSPRO 
00002  PRNTZ 

00003  TAPE 

00004  DL11I0 

00005  WALCAL 

00006  SPSHIS 

00007  SPSEXW 

— 00008  SPSROT 

00009  SPSSHI 

00010  SPSHAN 

0001 1 SPSHAF 

00012  SPSLCHJ 

00013  SPSEXP 

00014  SPSLOG 

00015  SPSMOV 

00016  SPSNEG 

00017  SPSMUL 

00018  SPSADD 

00019  SPSP2R 

00020  SPSR2P 

00021  SPSA2B 

00022  SPSSET 

00023  SPSS I Z 

00024  SPSFFT 

00025  SPSBPA 

00026  SPSBNO 

00027  SPSBLI 

00028  FFTIFT 

00029  WALSH 

00030  FSICO 

00031  FSQFtT 

00032  FATAN 

00033  FLOG 

00034  FEXP 


00001  DECONV 

00002  SIZE 

00003  FFOUR 

00004  FWT 

00005  REVBIT 

00006  NLOG 

00007  NEXP 

00008  UNWRAP 

00009  REMOVE 

00010  SET 

00011  FMIN 

00012  FMAX 

00013  SUM 

00014  MULT 

00015  DIVD 

00016  ADO 

00017  SUB 

00018  COPY 

00019  SWAP 

00020  AMPL 

00021  CONV 

00022  RE 

00023  IM 

00024  SHIFTR 

00025  SHIFTL 

00026  ROTR 

00027  ROTL 

00028  SINE 

00029  COSINE 

00030  TAPE 

00031  ZERO 

00032  NORM 

00033  AUTO 

00034  MARKEL 

00035  DISCR 

00036  NNR 

00037  SCAN 

00038  PROJ 

00039  KBPLOT 

00040  KBPROJ 

00041  XYPLOT 

00042  GTPROJ 

00043  INPUT 

00044  NEWFIL 

00045  PLOTS 

00046  BELL 

00047  DAT SWT 

00048  BY2IN 

00049  READ IT 

00050  READUN 


■m 


■ 


LIBR 


V05A 


TCSLIB 

OBJ 

29- AUG- 76 

SEQ. 

NAME 

VERSION 

OOOOI 

INITT 

00057  TUINDO 

00002 

FINITT 

00058  LWINDO 

00003 

BELL 

00059  DWINDO 

00004 

POINTR 

— — - - - 

00060  W INCOT 

00005 

DASHR 

00061  RESCAL 

00006 

DASHA 

00062  USDRAW 

00007 

DSHREL 

00063  URSCAL 

00008 

DSHABS 

00064  USECOT 

00009 

DRAWR 

00065  UREVCT 

00010 

POINT A 

• ____ «« _ __ 

00066  SVSTAT 

00011 

SDRAUA 

00067  GENFLG 

00012 

DRAWA 

00068  ANMODE 

00013 

MOVER 

00069  FSTPNT 

00014 

REL2AB 

00070  TEKMAC 

00015 

SMOVEA 

00016 

MOVEA 

00017 

VCURSR 

00018 

V2ST 

00019 

CLIPT 

00020 

PARCLT 

LIBR  V05A 

00021 

PNTREL 

00022 

PNTABS 

- — 

XYLIB 

. OBJ 

00023 

DRWREL 

00024 

DRWABS 

SEQ 

NAME 

00025 

MGVREL 

— — - - - - | 

00026 

SETTAB 

00001 

XYVECS 

00027 

RSTTAB 

00002 

ROT 

00028 

TABHOR 

00003 

UNSCLE 

00029 

TABVER 

00004 

XYREAD 

00030 

DSHMOD 

00005 

XYSCLE 

00031 

MODCHK 



00006 

CHARI 

00032 

TKDASH 

00007 

XYINT 

00033 

ERASE 

00008 

XY1 

00034 

HDCOPY 



00009 

XYO 

00035 

KIN 

00036 

KCM 

00037 

DCURSR 

00038 

ANCHO 

00039 

NEULIN 

LIBR  V05A 

00040 

CARTN 

00041 

LINEF 

GTLIB  . 

OBJ 

00042 

BAKSP 

00043 

HOME 

SEQ. 

NAME 

00044 

NEWPAG 

00045 

RESTAT 

OOOOI 

GTPLOT 

00046 

MOVABS 



00002 

GTPAK4 

00047 

VECMOD 

00003 

GTPAK3 

00048 

CSIZE 

00004 

GTPAK2 

00049 

PNTMOD 



00005 

GTPAK1 

00050 

XYCNVT 

00006 

DL 1110 

00051 

LVLCHT 

00052 

REVCOT 

00053 

PCLIPT 

00054 

PWINDO 

00055 

VWINDO 

00056 

SUINDO 

29— AUG— 76 
VERSION 


29— AUG— 76 
VERSION 


mm ' 
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III . Listing  of  Major  Computer  Programs 

Twelve  seismic  recognition  programs  and  twelve  imagery  recognition  programs 
are  listed  in  the  following  pages.  Emphasis  is  placed  on  programs  that  provide 
displays  on  line  printer,  screen  of  the  key-hoard,  and  the  XT  plotter.  Thus 
with  the  aid  of  this  software  package,  the  recognition  lyrtfrt’  is  fully  inter- 
active. For  example  in  imagery  recognition,  a display  of  desired  segment  of 
a picture  can  he  made  by  specifying  the  row  number  and  column  number  of  the 
upper  leftmost  picture  element  as  well  as  the  size  of  the  picture  segment. 

Included  in  the  seismic  programs  are  the  program  to  compute  autocovariance 
features  which  are  extremely  effective  in  seismic  discrimination,  and  the 
program  for  learning  sample  selection  in  nearest-neighbor  classification  rule 
(KNR).  Learning  sample  selection  is  needed  because  of  a large  variation  in 
quality  among  all  seismic  signatures. 

Included  in  the  image  programs  are  the  program  to  generate  a modified 
gradient  picture  which  is  much  better  than  the  more  familiar  gradient  picture, 
and  the  program  to  tabulate  a third-order  texture  measure  for  each  of  the  6U 
subpictures.  In  experimental  study  performed,  the  largest  texture  measure 
correctly  identifies  the  location  of  interesting  object  in  all  reconnaissance 
images  studied. 
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Seismic  Program  #1 


This  program  computes  the  autocovariance  features.  l6  features  are 
taken  from  the  normalized  record. 


FORTRAN 

V06.  13 

OO  OO:  OO 

21 -AUG-76 

0001 

0002 
0003 

DIMENSION  A ( 1 200 ) > SUM (17), 
CALL  SETFILO.  'ATO  DAT',  IR 
DEFINE  FILE  1 ( 323. 32,  U.  LN ) 

S(  16) 

. 'DK',  0) 

0004 

0005 

0006 

DO  3 L-l. 323 
R£AD(2)A 
SM=0  O 

0007 

0008 
0009 

1 

DO  1 1-1. 1200 
SM-SM+A ( I ) 

SM— SM/1200.  0 

0010 

0011 
0012 

7 

DO  7 1-1 , 1200 
A( I )— A( I ) -SM 
DO  6 1-1. 17 

0013 

0014 

0015 

SUM  ( I > -0  0 
K= 1 20 1 - I 
DO  6 J—  1 . K 

0016 

0017 

0018 

6 

KK— I ♦ J— 1 

SUM  ( I ) —SUM  ( I ) 4-A  ( J ) *A  ( KK  ) 
CONTINUE 

0019 

0020 
0021 

2 

DO  2 1-1.  16 

S( I )— SUM( 1*1 )/SUM( 1 ) 

CONTINUE 

0022 

0023 

0024 

3 

WRITE(1'L>S 
CONTINUE 
CALL  EXIT 

0025 

END 

ROUTINES  CALLED: 
SETFIL.  EXIT 


OPTIONS  -/OP: 2 

BLOCK  LENGTH 

MAIN.  2739  (012346)* 

♦♦COMPILER  CORE** 

PHASE  USED  FREE 

DECLARATIVES  00622  13026 
EXECUTABLES  00863  14783 
ASSEMBLY  01119  19169 


t 


...... 


Seismic  Program  #2 

This  program  computes  the  entropy  in  two  definitions  from  G(f),  the 
normalized  spectrum  of  seismic  signature: 

<5l  = ZLCH{)  , >52=  ZG({)UQU) 


FORTRAN  V06.  13 


OO: 00  OO  21— AUG— 76 


0001 

0002 

0003 

0004 

0005 

0006 

0007 

0008 

0009  7 

0010 

0011 

0012  2 

0013 

0014 

0015 

0016 

0017 

0018  5 

0019 

0020 
0021 
0022 

0023 

0024 

0025 

0026 

0027  10 

0028 

0029  1 

0030  9 

0031 


DIMENSION  C(257). A( 1200). X(2, 1024) 
COMPLEX  E ( 1024 ) 

EQUIVALENCE (E. X) 

CALL  SETFILC2,  'FT1  DAT'.  IER.  'DK'.O) 
DEFINE  FILE  2 ( 323.  4,  U.  NP ) 

CALL  SI ZE ( C. 1024) 

DO  1 J-l.  323 
DO  7 1-1.  1024 
E<  I )«<0  0.0  O) 

READt 1 ) A 
DO  2 1-1. 1024 
X( 1. I )=A< I ) 

CALL  FFOUR(E.  1024.  C. -1.  0) 

SUM-0  0 
DO  5 1-2. 512 
X(l. I >=CABS<E< I ) > 

SUM— SUM+X ( 1 . I ) 

CONTINUE 
S1=0  O 
S2=0  O 

DO  10  1-2.512 
TMP-X1 1.  I >/SUM 
IF ( TMP.  EQ  O O)  GO  TO  10 
TEM=ALOG ( TMP ) 

SI =S1 +TEM 

S2=S2+TMP*TEM 

CONTINUE 

WR I TE ( 2 ' J ) S 1 . S2 

CONTINUE 

CALL  EXIT 

END 


ROUTINES  CALLED: 

SETFIL.  SIZE  . FFOUR  . CABS  . ALOG  . EXIT 


OPTIONS  -/OP: 2 

BLOCK  LENGTH 

MAIN.  7349  (034552)* 

** COMPILER  CORE** 

PHASE  USED  FREE 

DECLARATIVES  00622  15026 
EXECUTABLES  00953  14695 
ASSEMBLY  01207  19081 


Seismic  Program  #3 


This  program  computes  the  power  cepstrum  of  seismic  signature  in  steps: 
seismic  signature-*  FFT->-ln  of  (normalized  spectrum)  -*IJT -►power  cepstrum 


FORTRAN  V06.  13 


00:00:00  21 -AUG- 7 6 


0001 

0002 

0003 

0004 

0005 

0006 

0007 

0008 

0009  7 

0010 
OOl  1 

0012  2 

0013 

0014 

0015 

0016 

0017 

0018 

0019 

0020 

0021  5 

0022 

0023 

0024 

0025 

0026  6 

0027 

0028 

0029 

0030  3 

0031 

0032 

0033  1 

0034  9 

0035 

0036 


DIMENSION  C ( 257 ) , A ( 1200 ) » X ( 2»  1024 ) 
COMPLEX  E ( 1024 ) 

EQUI VALENCE (E. X) 

CALL  SETFIL ( 3.  'FT2  DAT'.  IER.  'DK'.O) 
DEFINE  FILE  3 ( 323. 32. U. NP ) 

CALL  SI ZE ( C. 1024) 

DO  1 J= 1 . 323 
DO  7 1-1. 1024 
E<  I )-<0  0.0  0) 

READ ( 1 ) A 
DO  2 1*1. 1024 
X ( 1. I )=A( I ) 

CALL  FF0UR1E. 1024, C. -1  O) 

E<  1 ) = <0  0,0  O) 

SUM=0  O 

DO  5 1*2.  1024 

X ( 1 . I ) *CABS ( E ( I ) ) 

X( 1. I >=X< 1. I )*X< 1. I ) 

SUM=SUM*X< 1, I ) 

X ( 2,  1 1=0  O 
CONTINUE 
DO  6 1=2.  513 
JO* 1026- I 

X < 1 . I ) = ( X< 1,  I )+X( 1.  JJ) )/(2  0*SUH> 

X ( 1 . J J ) = X ( 1 . I) 

CONTINUE 

DO  3 1=1, 1024 

IF  ( X ( 1 , I ).  EQ  0 0)  GO  TO  3 

X ( 1 , I ) =ALOG ( X < 1 . I ) ) 

CONT I NUE 

CALL  FF0UR1E.  1024, C.  1 O) 

WRITE(3'J) <X< 1. I). 1-1, 16) 

CONT I NUE 
REWIND  1 
CALL  EXIT 
END 


ROUTINES  CALLED: 

SETFIL.  SIZE  . FFOUR  . CABS  . ALOG  . EXIT 
OPTIONS  -/OP: 2 


BLOCK  LENGTH 

MAIN.  7427  ( 035006)* 


♦♦COMPILER  CORE** 

PHASE  USED  FREE 
DECLARATIVES  00622  15026 
EXECUTABLES  00953  14695 
ASSEMBLY  01239  19049 


r\.  ' r"  ' "2 


Seismic  Program  ffh  Removal  of  spikes  in  the  multichannel  data  tape. 


OOOl 

DIMENSION  I At  1200).  X( 1024). Y( 1024) . SUMt 17).  S( 16) 

0002 

CALL  SETFILt  1.  'QXF.  FBM',  IER,  'DK' . 0) 

0003 

DEFINE  FILE  1 (213. 32. U. NL ) 

0004 

11 

FORMATt IX.  14.  17) 

0005 

X<  1 ) = 1 0 

0006 

READ <6.  7 )KK 

H 

0007 

DO  15  1=2.  1024 

H 

0008 

13 

X ( I ) = X(  1-1  > + l.  0 

X 

Ui 

0009 

1 

READ (6.  7)11 

OOIO 

7 

FORMATt 13) 

OOll 

IF ( 1 1.  EQ  0)  GO  TO  13 

w 

0012 

DO  20  1 = 1.  II 

z 

H 

0013 

READ ( 2 ) I A 

-1 

0014 

KK-KK+1 

0015 

20 

CONTINUE 

t- 

o 

0016 

6 

FORMATt IX.  17) 

-1 

0017 

DO  4 1 = 1,  1024 

1 

CD 

0018 

4 

Y ( I ) =FLOAT ( I At  I ) ) 

* 

* 

0019 

10 

CALL  NEWPAG 

0020 

CALL  KBPLOT  ( X.  Y,  1024.0.  1023.0.780) 

i 

O 

♦ 

0021 

READ ( 6.  12)  IN 

0022 

12 

FORMATt 14) 

1 

I n 

0023 

IFt  IN.  EQ  -1  > GO  TO  8 

z 

K O 
O w 

0024 

IFt IN  EQ  -2)  GO  TO  1 

Q . 

U N 

z 

UJ 

0025 

CALL  L I NE (IN) 

1 H ft 

3 

0026 

IP=IN+68 

CO  ^ 

>0 

0027 

IFt IP.  GT  1024)  IP* 1024 

U _l  s 

U.  1 

(N 

fs 

0028 

DO  25  I = I N, IP 

1 w 

0029 

WRITE(6, 11)1. lAtl) 

z J z 

0030 

25 

CONTINUE 

M M O 

I h-  Ll  *-< 

y z 

0031 

CALL  L I NE (IP) 

! 3 »-  H 

o - 

0032 

24 

READ(6.  12) IN 

o lu  a. 

oc  a)  o 

ffi  c 

0033 

IFt IN  EQ  0)  GO  TO  10 

1 

0034 

23 

IFt IN  GE  1023)  GO  TO  18 

l 

— 

0035 

IFt IN  LE  2)  GO  TO  19 

0036 

Y ( IN ) = ( Y ( IN+2)+Y( IN+ 1 ) +Y ( IN-1 )+Y( IN- 

•2)  )/4.  O 

0037 

I At IN)=Y( IN) 

0038 

GO  TO  24 

0039 

19 

Y ( I N ) =Y ( IN+1 ) 

0040 

IAt IN ) = I A ( IN+1 ) 

0041 

GO  TO  24 

0042 

18 

Y ( IN ) =Y ( IN-1 ) 

0043 

IAt IN)*IA( IN-1 ) 

0044 

GO  TO  24 

0043 

8 

DO  3 1=1. 17 

0046 

SUM ( I ) =0  0 

0047 

K-1023-I 

0048 

DO  3 3=1.  K 

0049 

J3-I+J-1 

0050 

SUMt I >=SUH( I )+Y( J)*Y( JJ) 

0051 

3 

CONTINUE 

0052 

DO  2 1 = 1.  16 

0053 

St  I ) —SUM ( I ♦ 1 )/SUM( 1 ) 

0054 

2 

CONTINUE 

0053 

WRITE (l'KK)S 

0056 

■ 1 

GO  TO  1 

0057 

13 

CALL  EXIT 

0058 

END 

// 


♦♦COMPILER  CORE** 

PHASE  USED  FREE 
DECLARATIVES  00622  13026 
EXECUTABLES  01023  14623 
ASSEMBLY  01427  18861 


Seismic  Program  #5 


NNR  classification  program  with  learning  sample  selection 
and  1 learning  sample  per  class. 


FORTRAN 

0001 

0002 
0003 

V06  13 

00:00:00  21 -AUG- 7 6 PAGE  1 

DIMENSION  X ( 323 ) . Q ( 323 ) . LS ( 323 ) 

CALL  SETFILd.  'QX1  DAT'.  IR.  'DK'.  0) 

DEFINE  FILE  1 ( 323. 646. U. NL ) 

0004 

0005 

0006 

CALL  SETFIL ( 3,  'PQ2  DAT'.  IE.  'DK'.O) 
DEFINE  FILE  3(323.  1. U.  NP) 

MS  1-0 

0007 

0008 
0009 

3 

DO  3 1-1, 323 
READ ( 3' I )LS< I ) 
CONTINUE 

OOIO 

DO  1 K-24. 323 

OOll 

IF(LS(K)  EQ  2)  GO  TO  1 

0012 

READ< 1 'K)Q 

0013 

DO  2 1-1,  181 

0014 

IF(LS( I ) EQ  1 ) GO  TO  2 

0015 

READd'I  >X 

0016 

HS2<=0 

0017 

DO  5 N-l , 323 

0018 

LT=1 

0019 

IF ( X ( N ).  LE  Q(N) ) LT-2 

0020 

IF (LT— LS(N) >5.7.5 

0021 

7 

MS2=HS2d 

0022 

5 

CONTINUE 

0023 

IF ( MS2.  LE  MSI)  GO  TO  2 

0024 

R3-FL0AT(MS2-2)/321  0 

0025 

WR I TE ( 5. 14 )R3 

0026 

14 

FORMAT (2X.  'TOTAL  CLAS.  RATE'.  F9.  4) 

0027 

WRITE(5.  15>MS2. K.  I 

0028 

15 

FORMAT  ( lOX'TMP.  MAX.  ' 14.  2X 'EAQK.  SAMPLE' 1 4.  2X 'EXP.  SAMPLE ' H 

0029 

MS  1 =MS2 

0030 

2 

CONTINUE 

0031 

1 

CONTINUE 

0032 

CALL  EXIT 

0033 

END 

ROUTINES  CALLED: 

SETFIL. 

FLOAT  . EXIT 

OPTIONS 

-/OP: 2 

BLOCK 

LENGTH 

MAIN. 

2352  (011140)* 

••COMPILER  CORE** 

PHASE  USED  FREE 
DECLARATIVES  00622  15026 
EXECUTABLES  00943  14705 
ASSEMBLY  01371  18917 
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Seismic  Program  #6 


NNR  classification  program  with  2 learning  samples (selected)  per  class. 


0001 

0002 
0003 

DIMENSION  XI (323).  X2 ( 323 > . Q2 ( 323 ) . Q1 (323).  LS(323) 
CALL  SETFIL(  1.  'QX1.  DAT'.  IR,  'DK'.  0) 

DEFINE  FILE  1 ( 323.  646.  U.  NL ) 

0004 

0005 

0006 

CALL  SETFIL ( 3.  'PQ2.  DAT'.  IE.  'DK',0) 
DEFINE  FILE  3( 323, 1 . U. NP ) 

MS  1=0 

0007 

0008 
0009 

3 

DO  3 K=l.  323 

READ(3'K)LS(K) 

CONTINUE 

0010 

READ ( 6,  6)11.  12 

001 1 

6 

FORMAT (213) 

0012 

READ( I'll )Q1 

0013 

READ( 1 ' 12) XI 

0014 

DO  1 K=25. 323 

0015 

IF(LS(K)  EQ  2)  GO  TO  1 

0016 

READ( l'K)Q2 

0017 

DO  8 1-1 . 323 

0018 

IF(Q2(I>  GT  OKI))  Q2(I)=01(I) 

0019 

8 

CONTINUE 

0020 

DO  2 1 = 1.  181 

0021 

IF(LS(  I ).  EQ.  1)  GO  TO  2 

0022 

READ( 1 ' I ) X2 

0023 

MS2-0 

0024 

DO  12  N=  1 . 323 

0025 

IF(X2(N)  GT.  XKN)  ) X2(N)=X1(N> 

0026 

12 

CONTINUE 

0027 

DO  5 N=l. 323 

0028 

LT-1 

0029 

IF(X2<N>.  LE.  Q2(N>  ) LT-2 

0030 

IF (LT— LS(N) )5» 7.  5 

0031 

7 

MS2=MS2+1 

0032 

5 

CONTINUE 

0033 

IF ( MS2.  LE  MSI)  GO  TO  2 

0034 

R3—FLOAT (MS2-4)/319.  0 

0035 

WRITE (5. 1 4 )R3 

0036 

14 

FORMAT ( 2X , 'TOTAL  CLAS.  RATE ' . F9.  4) 

0037 

WRITE < 5.  15)MS2, K.  I 

0038 

IS 

FORMAT ( 1 OX' TMP  MAX.  ' 14. 2X 'EAOK.  SAMPLE' 14. 2X'EXP  SAMPLE'I4> 

0039 

MSI =MS2 

0040 

2 

CONTINUE 

0041 

1 

CONTINUE 

0042 

CALL  EXIT 

0043 

END 

ROUTINES  CALLED: 

SETFIL.  FLOAT  . EXIT 

OPTIONS  -/OP: 2 

BLOCK  LENGTH 

MAIN.  3778  (016604)* 

••COMPILER  CORE** 

PHASE  USED  FREE 

DECLARATIVES  00622  13026 
EXECUTABLES  01023  14623 
ASSEMBLY  01451  18837 


/3 


Seismic  Program  fj 


NNR  classification  program  with  3 or  more  than  3 selected  learning  samples/class 


DIMENSION  XI (323). X2<323>.  Q2<323>. 01(323),  LS<323> 

CALL  SETFILd.  'QX1  DAT'#  IR.  'DK'.O) 

DEFINE  FILE  1 ( 323. 646. U.  NL ) 

CALL  SETFIL<2. 'PQ2  DAT'. IE. 'DK'.O) 

DEFINE  FILE  2 ( 323. 1 . U. NP ) 

MS  1-0 

DO  3 K— 1 » 323 
READ(2'K)LS<K> 

CONTINUE 

READ (6.  6)11.  12.  13 
FORMAT (313) 

MM=I3*2 

TMP=FLOAT ( 323— MM ) 

WRITE ( 5. 10)11. 12 

READ( I'll )Q1  

READ< 1 ' 12) XI 
I 3- I 3-2 
DO  4 J*l. 13 
READ (6. 9) II. 12 
FORMAT (213) 

WRITE<3.  10)11.  12 

FORMAT ( 2 X.  'EARTHQUAKE  SAMPLE' 14,  2X.  'EXPLOSION  SAMPLE'I4> 

READ (I'll )Q2 
READ! 1 ' 12 ) X2 

DO  4 K-1.323  

IF(Q1(K)  GT  G2<K>>  Q1<K)-Q2<K> 

IF(X1(X).  GT.  X2(K)>  X1(K)-X2(K)  ►- 

CONTINUE  y 

DO  1 K-24.323  UJ 

IF(LS(K)  EQ  2)  GO  TO  1 . *» 

READ(1'K)Q2  « S 

DO  8 1-1.323  2 * g 

IF(Q2(I).  GT.  Q1  ( I ) ) Q2(  I >— Q1  ( I ) E I-  U Q <N  D D 

rrmjTiMiir  2 H O UNNPI 

CONTINUE  . . g — | (0  4 00 

DO  2 1*1.181  a . Z I 30-H 

IF(LSU)  EQ.  1)  GO  TO  2 J h J I 

READ(  1 ' I ) X2  & * ' U<A 

M52=0  O -J  S X > U J 

ui  n uj  w j 

DO  5 N— 1.323  w j U1  V-  ffi> 

it— f LJ  . (A  "WC4J 

LI-1  Z_IZ  CL  <X  X t-CQ 

IF  (AMIN1  (X1(N),X2(N)).  LE.  Q2(N)  ) LT-2  M ~ ° u Z £ ? fj  R 5 

IF  (LT— LS(N)  )5»  7.  3 =>  k 0=  U U u cn 

MS2-MS2+1  gft  & dZ  J 

CONTINUE 

IF  ( MS2  LT  MSI)  GO  TO  2 

R3-FL0AT ( MS2-MM ) /TMP 
WRITE (3. 1 4 )R3 

FORMAT  ( 2 X.  'TOTAL  CL  AS.  RATE  ' . F9.  4 ) 

WRITE<3. 15 )MS2. K. I 

FORMAT ( lOX'TMP.  MAX.  '14. 2X'EAQK  SAMPLE' 14.  2X 'EXP.  SAMPLE'I4) 

MSI— MS2 

CONTINUE 

CONTINUE 

CALL  EXIT 

END 
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I Sei3mic  Program  #8  Seismic  Program  #9 

Calculation  of  distance  in  feature  space  Two  dimensional  display  based  on  two  features, 

to  be  stored  in  computer  for  NNR  classification 
program  use. 
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Seismic  Program  #10 
Subroutine  PROJTfor  two  dimensional  display  use. 


OOOl 

SUBROUTINE  PROJT  ( X.  Y,  N1 . N2,  ID.  Z > 

0002 

BYTE  LINE(121>.  Z <N1 , N2 > . Ml , M2,  M3 

0003 

REAL  X ( N1 , N2 ) . Y ( N1 , N2 ) , XX ( 7 > 

0004 

DATA  Ml.  M2.  M3/'*'.  'Q'.  'X'/ 

0003 

DATA  IBLK,  IHOR.  IVER.  IPLUS/' 

0006 

WRITE (5. 400) 

0007 

400 

FORMAT ( 1H1 ) 

0008 

200 

FORMAT < 1 X,  1PE10  3. 6(10X.  1PE10  3>) 

0009 

300 

FORMAT( IX.  1PE9  2.  121A1 ) 

OOIO 

XMAX=X< 1,  1 ) 

0011 

XMIN=XMAX 

0012 

YMAX=Y<  1.  1 ) 

0013 

YMIN=YMAX 

0014 

DO  1 1=1. N1 

0013 

DO  1 J=1.N2 

0016 

IF  ( XMAX.  LT.  X ( I . J)  ) XMAX-X(I.J) 

0017 

IF ( XMIN.  GT.  X<  I.  J)  )XMIN*X(  I.  J) 

0018 

IFIYMAX  LT  YU.J))  YMAX=Y(I.J) 

0019 

1 

IFtYMIN  GT  Y( I. J) ) YMIN=Y(I.J) 

0020 

K=66*IABS< ID )-5 

0021 

K=(K/10>*10 

0022 

YS=FLOAT  < K ) / ( YMAX- YM IN ) 

0023 

XS=< XMAX-XMIN)/120  0 

0024 

J=0 

0025 

DO  2 1 = 1.  121.  20 

0026 

U-J+l 

0027 

2 

XX ( J>  = < I-l )*XS+XMIN 

0028 

WRITE ( 3. 200 ) X X 

0029 

XS=120  0/<  XMAX— XMIN) 

0030 

DO  3 I-1.N1 

0031 

DO  3 J=l. N2 

0032 

X(I.J)  = (X<I.  J)-XMIN)*XS+1 

0033 

3 

Y(I.J)»(Y(I.  J)-YMIN)*YS+1.  5 

0034 

YS=( YMAX-YM IN) /FLOAT (K> 

0035 

K=K+2 

0036 

4 

K=K— 1 

0037 

IP=K-(K/10)*10 

0038 

LINE(1 )=IBLK 

0039 

IF(  IP.  EQ.  1)  LINE  ( 1 ) = IHOR 

0040 

DO  3 1=2.  120 

0041 

5 

LINE( I ) =L I NE ( 1 ) 

0042 

LINE! 1 >«IVER 

0043 

IF(IP  EQ  1)  L I NE ( 1 ) = I PLUS 

0044 

DO  6 1 = 1.  121. 20 

0045 

6 _ 

LINE< I ) =L I NE ( 1 ) 

0046 

DO  7 1=1. N1 

0047 

DO  7 J»1.N2 

0048 

IF(Y<  I.  J).  GE.  150.0)  GO  TO  7 

0049 

IF(  X ( I.  J).  GE  150  0)  GO  TO  7 

0050 

IP«INT(Y( I, J) ) 

0051 

IF(  IP.  LT.  K)  GO  TO  7 

0052 

JP= I NT < X ( I . J) ) 

0053 

IF(  ID.  LT.  0)  GO  TO  10 

0054 

IF  (IP.  NE  K)  GO  TO  7 

0055 

10 

LP—L I NE ( JP ) 

0001 

0002 

0003 

0004 

0005 

0006 

0007 

0008 

0009 

0010 

0011 

0012 

0013 

0014 

0015 

0016 

0017 

0018 

0019 

0020 
0021 
0022 

0023 

0024 


0056 

LINE ( JP)— Z ( I . J) 

0057 

IF (LP.  EQ.  M2)  GO  TO  15 

0058 

IF (LP.  EO  M3)  GO  TO  15 

0059 

GO  TO  16 

0060 

IS 

IF  (LP  NE.  LI.JE(  JP)  ) L I NE  ( JP ) -Ml 

Subroutine 

0061 

16 

IF(LP  EQ  Ml)  LINE( JP)— Ml 

PROJT 

0062 

7 

CONTINUE 

continued. 

0063 

XS=(K— 1 )*YS*YMIN 

0064 

WRITE < 5.  300) XS.  LINE 

0065 

IF (K.  NE1)  GO  TO  4 

0066 

WRITE (5. 200) XX 

0067 

RETURN 

0068 

END 

ROUTINES  CALLED: 

I ABS  . FLOAT  . INT 


OPTIONS  -/OP  2 

BLOCK  LENGTH 

PROJT  926  (003474)* 

••COMPILER  CORE** 

PHASE  USED  FREE 

DECLARATIVES  00783  14865 
EXECUTABLES  01023  14625 
ASSEMBLY  01603  18685 

DIMENSION  I A(  1 200 ) » X<1 200).  Y1U200).  Y2U200).  ZU200) 
DEFINE  FILE  1 < 300. 1 200. U, NL ) 

Z< 1 >-l  O 
DO  1 1-2.  1200 
1 Z<  I )-Z(  1-1  > + l.  0 

DO  4 1-1.  1200 
XX— FLOAT ( I— 1 ) 

XX— 6.  2832*XX/1 199.  O 

4 X(I)*0  54-0  46*COS(XX) 

DO  5 J-l, 300 

READ< l'J)IA 

DO  9 1=1. 1200 

Y 1 ( I ) —FLOAT ( I A ( I ) ) 

Y2( I )*X ( I )*Y1 < I ) 

9 IA( I )— Y2( I ) 

CALL  NEWPAG 

CALL  KBPLOT ( Z. Yl.  1200. 0.  1023. 391.  780) 

CALL  KBPLOT (Z.  Y2.  1200.  O.  1023.  O.  390)  Siesmic  Program  #11 

WR I TE ( 6 . 8 ) J 

8 FORMAT  ( 1 X . 1 3 ) Hamming  window 

WRITE<  1 'J)  I A computation. 

5 CONT I NUE 
CALL  EXIT 
END 

ROUTINES  CALLED: 

FLOAT  . COS  . NEWPAG.  KBPLOT.  EXIT 

OPTIONS  -/OP: 2 

BLOCK  LENGTH 

MAIN.  12314  (060064)* 

••COMPILER  CORE** 

PHASE  USED  FREE 

DECLARATIVES  00622  15026 
EXECUTABLES  00943  14705 
ASSEMBLY  01195  19093 


I 


n 


Image  Program  #1 


Modified  gradient  computation  and  XY-plotter  display  of  the  modified  gradient 
picture  for  the  shaded  area  as  shown  below. 


LIM  is  modified 
gradient  threshold. 


0001 

0002 

0003 

0004 

0005 

0006  6 

0007 

0008 

0009 

0010 
0011 
0012 

0013 

0014  4 

0015 

0016 

0017 

0018 

0019 

0020 
0021 
0022 

0023 

0024 

0025 

0026 

0027 

0028 

0029 

0030 

0031 

0032 

0033 

0034  3 

0035 

0036  3 

0037 

0038 

0039 


DIMENSION  I A( 1024 ) > IB(1024). IC(1024>. ID!1024) 

COMMON  /SWITCH/NO.  Nl.  N2.  N3.  N4.  N5.  N6.  N7,  N8,  N9.  N10.  Nil.  N12.  N13.  N14 
CALL  SSUTCH! 14.  N14) 

IF  ( N14.  EQ.  2)  REWIND  1 
READ  (6.  6)LIM.  II.  12.  Jl.  J2 
FORMAT (12.  413) 

IPT=0 

THR=FLOAT (LIM)  

THR=THR*THR*THR*THR 
CALL  XYINIT (E. 1) 

I Y=100 

DO  4 1*1. II 

CALL  READUN ( I A.  NPT ) 

CONTINUE  

CALL  INPUT ( I A. NPT) 

CALL  INPUT ( IB. NPT) 

CALL  INPUT! IC. NPT) 

DO  2 1*1.  12.  2 
IY=IY+10 

CALL  INPUT! ID. NPT)  

I X=0 

DO  3 J*J1.  J2 

IX=IX+10  

K 1 = I ABS ! I A!  J)-ID!  J4-3)  )4-IABS!  IA!  j4-3)-ID!  J)  ) 

K2=  I ABS ! I A ( J4- 1 )-ID(  J-*-2)  I+IABS! IB! J+3)-IC! J)  ) 

K3=IABS!  I A!  J+2>-ID!J*l  ) ) 4-1  ABS!  IB!  J)-IC(  J+3)  ) 

K4=  I ABS  (IB!  04- 1 )-IC(  J+2)  I+IABS!  IB(J4-2)-IC(  J4-1  ) ) 

VALUE *FL0AT ( K 1 #K2 ) *FL0AT ( K3*K4 ) 

IF ( VALUE.  LE.  THR)  GO  TO  5 
IF!  IPT.  EQ.  1 ) GO  TO  3 
CALL  IXYPT ( I Y.  IX.  O) 

I PT* 1 

GO  TO  3 

IF!  IPT.  EQ.  1 ) CALL  IXYPT!  IY.  IX.  1) 

IPT  *0  

CONTINUE 

CALL  INPUT (I A.  NPT) 

IF!  IPT.  EQ.  1)  CALL  IXYPT!  IY.  IX.  1 ) 

IY-IY4-10 

19 


V 


Image  program  it  1 continued. 


0040 

0041 

JJ-J2+1 

IPT-0 

0042 

0043 

0044 

0045 

0046 

0047 

DO  7 J-Jl.  J2 
JJ-JJ-1 

K1=IABS< IB< JJ)-IA< JJ+3) )*IABS< IB< JJ+3)-IA< JJ> ) 
K2-IABS< IB< JJ+1 )-IA< JJ+2) )+IABS< IC< JJ*3)-ID< JJ> ) 
K3-I ABS< IB< JJ+2 ) -I A < JJ+1 ) >+IABS< IC< JJ)-ID< JJ+3) ) 
K4=IABS< IC< JJ+1 ) -ID < JJ+2) )+IABS< IC< JJ+2)-ID< JJ+1 ) ) 

0048 

0049 

0050 

0051 

0052 

0053 

VALUE -FLOAT  < K 1 *K2  > *FLOAT  < K3*K4 ) 
IF < VALUE  LE.  THR)  GO  TO  8 
IF  < IPT.  EQ  1 ) GO  TO  9 
CALL  I XYPT  < 1 Y.  IX.  0) 

IPT-1 
GO  TO  9 

0054 

0055 

8 

IF<IPT  EQ.  1)  CALL  I XYPT < I Y.  I X,  1 ) 
I PT=0 

0056  9 IX-IX-10 


0057 

0058 

7 

CONTINUE 

IF < IPT.  EQ.  1 ) CALL  IXYPT<  IY.  IX.  I ) 

0059 

0060 
0061 

DO  10  J-l , 1024 
ITM— IC< J) 

IC< J)«IA< J> 

0062 

IB< J)-ID< J) 

0063 

io 

IA< J)-ITM 

0064 

2 

CONTINUE 

0065 

CALL  XYEND 

0066 

CALL  EXIT 

0067 

END 

ROUTINES  CALLED: 

SSWTCH,  FLOAT  , XYINIT.  READUN.  IW>UT  . IABS  . IXYFT 
XYEND  . EXIT 

OPTIONS  -/ON, /OP: 2 

BLOCK  LENGTH 

MAIN.  5023  <023476)* 

SWITCH  15  <000036) 

••COMPILER  CORE** 

PHASE  USED  FREE 

DECLARATIVES  00622  15026 
EXECUTABLES  01126  14522 
ASSEMBLY  01456  18832 


Image  Program  #2 

Subroutine  HST  to  plot  histogram  of  array  X(N)  on  line  printer (H=array  length). 


OOOl 

SUBROUTINE  hST(X.N) 

0002 

BYTE  L I NE (121). TM (121) 

0003 

REAL  X ( N ) » XX ( 7 ) 

0004 

DATA  IBLK.IVER.ISTR/' 

0005 

200 

FORMAT (IX.  1PE10  3.6(10X.  1PE10.  3)) 

0006 

300 

FORMAT( IX,  13.  IX.  121A1 ) 

0007 

XMAX=X ( 1 ) 

0008 

XMIN-XMAX 

0009 

DO  1 1=1. N 

0010 

IF  < XMAX.  LT.  X(  I ) ) XMAX-X(I) 

0011 

1 

IF ( XMIN.  GT.  X ( I ) ) XMIN-X(I) 

0012 

XS=( XMAX- XM IN )/120.  0 

0013 

U-0 

0014 

DO  2 1*1.  121. 20 

0015 

J=J+1 

0016 

2 

XX( J)=( 1-1 )*XS+XMIN 

0017 

WRITE ( 5, 200 ) X X 

0018 

XS—120.  0/( XMAX-XMIN) 

0019 

DO  3 1*1. N 

0020 

3 

X(I)=(X(I)-XMIN)*XS*1 

0021 

LINE ( 1 ) * I BLK 

0022 

DO  5 1=2.  120 

0023 

5 

L I NE  ( I ) =L  I NE  ( 1 ) 

0024 

LINE ( 1 )=IVER 

0025 

DO  6 1=1.  121. 20 

0026 

6 

L I NE  ( I ) =L  I NE  ( 1 ) 

0027 

DO  7 1 = 1.  N 

0028 

IP=INT ( X ( I ) ) 

0029 

IF  (IP.  LE.  1 ) GO  TO  7 

0030 

DO  8 J=l,  IP 

0031 

8 

TM( J)=LINE( J) 

0032 

DO  4 U=l.  IP 

0033 

4 

LINE ( J)=ISTR 

0034 

WRITE (5. 300) I,  LINE 

0035 

DO  9 J*l.  IP 

0036 

9 

LINE( J)=TM( J) 

0037 

7 

CONTINUE 

0038 

WRI TE ( 5,  200) XX 

0039 

RETURN 

0040 

END 

ROUTINES  CALLED: 

INT 

OPTIONS  -/OP  2 

BLOCK  LENGTH 

COPY  572  (002170)* 

•♦COMPILER  CORE** 

PHASE  USED  FREE 

DECLARATIVES  00783  14865 
EXECUTABLES  00363  14785 
ASSEMBLY  01347  18941 


Image  Program  #3  Milpoint  transform 


T HP.  TMP 


TH  P.  DA  T 


OOOl 

DIMENSION  IA<120. 120).B(120) 

0002 

CALL  SETFILd.  'TMP  DAT'.  IER.  'DK'.O) 

0003 

DEFINE  FILE  1 ( 120. 240. U. NP ) 

0004 

CALL  SETF IL ( 2.  'TMP  TMP'.  I ERR,  'DK'.O) 

0005 

DEFINE  FILE  2 < 1 20. 1 20. U. NL ) 

0006 

DO  1 1*1. 120 

0007 

READ (2' I ) ( IA(I.  J).  J-l.  120) 

0008 

1 

CONTINUE 

0009 

11*1 

0010 

DO  2 1=2.  1 19 

0011 

I 1*1 ♦ I 

0012 

IFd  GT.  60)  11*1 1 — 120 

0013 

12*1-1 

0014 

Jl  = l 

0015 

DO  3 0-2.  119 

0016 

JO-J+J 

0017 

B(J)«0  0 

0018 

IF  ( J.  GT.  60)  GO  TO  7 

0019 

J2-JU— 1 

0020 

GO  TO  6 

0021 

7 

Jl-JU-120 

0022 

J2*l 20 

0023 

6 

DO  4 M=1 1 • 12 

0024 

MM-II-M 

0025 

DO  4 N=J1.  J2 

0026 

NN-JJ-N 

0027 

B(J)*B(J) +FLOAT ( I A ( M, N) )*FLOAT( I A(MM.  NN> > 

0028 

4 

CONTINUE 

0029 

DO  5 N-Jl.  J 

0030 

NN-JU-N 

0031 

5 

B < J ) =B ( J ) ♦FLOAT  < IA< I. N) ) ♦FLOAT ( I A ( I , NN ) ) 

0032 

9 

LL*( 12-11 +1 )*( J2-J1+1 )*1 

0033 

LL=LL#( J2-J1 )/2 

0034 

B ( J ) *B ( J ) /FLOAT ( LL ) 

0035 

3 

CONTINUE 

0036 

WR ITE(1'I)B 

0037 

2 

CONTINUE 

0038 

CALL  EXIT 

0039 

END 

ROUTINES  CALLED. 

SETFIL. 

FLOAT  . EXIT 

OPTIONS 

-/OP  2 

BLOCK 

LENGTH 

MAIN. 

29509  (163212)* 

♦♦COMPILER  CORE#* 

PHASE  USED  FREE 
DECLARATIVES  00622  15026 
EXECUTABLES  00943  14705 
ASSEMBLY  01271  19017 


0001 

0002 

0003 

0004 

0005 

0006 

DIMENSION  I A ( 256 ) , IB(256>.  IC<256>,  ID<256>.  IG<36>.  IPA(400, 36) 
CALL  SETFIL< 1. 'DAT  DAT', IER. 'DK'. 0) 

DEFINE  FILE  1 ( 256. 256. U. NP ) 

CALL  SETFIL ( 2.  'HGH  DAT',  IRR,  'DK',  0) 

DEFINE  FILE  2< 400. 36. U,  NL ) 

RAD-0  017453292519943 

0007 

0008 

0009 

0010 
0011 
0012 

6 

1 

Kb.AU (6.  6JLIM 
FORMAT ( 13) 

DO  1 1-1. 400 
DO  1 J=l, 36 
IPA< I. J ) =0 
THR—FLOAT (L1M) 

linage  Program  0h  Hough  transform 

f)4T  PM  T 

H.T. 

0013 

0014 

0015 

0016 

0017 

0018 

0019 

0020 

— — 

DO  2 1-1 . 253 
READ( 1 ' I ) I A 
II-I*1 

READ (l'II)IB 
11-11*1 
READ ( 1 ' I 1 ) IC 
11-11*1 
READ ( 1 ' I I ) ID 

vn  i . U/i  \ - 

H Qh.  PA  j 

C Q hiirtcj  ran  ) 

f = XcoiB  + y smP 

0021 

DO  3 0-1.  253 

0022 

K1-IABS( IA( J)-I0(O*3) ) ♦ I ABS ( I A ( J*3  > - 1 D < J ) ) 

0023 

K2*IABS( IA( J*1 >-ID( J*2> )*IABS( IB( J*3>-IC( J) ) 

0024 

K3— I ABS ( I A ( J*2 ) — I D ( J* 1 ) )*IABS( IB( J)-IC( J*3> ) 

0025 

K4=IABS( IB( J*1 >-IC( J*2) )*IABS( IB( J*2)-IC( J*1 ) ) 

0026 

VALUE-FLOAT <Kl*K2  > *FLOAT (K3*K4 > 

0027 

VALUE-SORT ( VALUE  f 

0028 

VALUE -SORT  (VALUE  ) 

0029 

IF (VALUE  LE  THR)  GO  TO  3 

0030 

DO  7 N-l.  36 

0031 

ANG-RAD*5  0*FLOAT(N-l> 

0032 

C=COS( ANG) 

0033 

S-SIN(ANG) 

0034 

LINE -FLOAT ( J)*C*FLOAT (254-1 )*S 

0035 

LINE* (LINE *401 >/2 

0036 

I PA ( L I NE . N ) - 1 PA (LI NE . N)*l 

0037 

7 

CONT I NUE 

0033 

3 

CONTINUE 

0039 

2 

CONTINUE 

0040 

DO  8 1 = 1. 400 

0041 

DO  9 J-l.  36 

0042 

IG( J)  = IPA( I.  J) 

0043 

9 

CONTINUE 

0044 

WRITE(2'I ) IG 

0045 

8 

CONTINUE 

0046 

CALL  EXIT 

0047 

END 

ROUTINES  CALLED: 

SETFIL.  FLOAT  . IABS  . SORT  . COS  . SIN  . EXIT 


OPTIONS  -/OP: 2 

BLOCK  LENGTH 

MAIN.  31653  (173512)* 

*# COMPILER  CORE** 

PHASE  USED  FREE 

DECLARATIVES  00622  15026 
EXECUTABLES  01103  14545 
ASSEMBLY  01415  18873 


23 


Image  Program  #5 


To  plot  the  picture  after  Hough  transform  on  the  screen  of  key-board. 

LIM  is  the  modified  gradient  threshold.  Lid'  is  the  threshold  of  Hough  transform. 


0001 

0002 

0003 

0004 

0005 

0006 

DIMENSION  I A ( 256 ) > IB(256>,  IC<236>.  ID(256>.  IPA ( 400.  36 ) . M ( 253 ) 
REAL  R1 (36). R2(36) 

CALL  SETF IL ( 1 . ' DAT  DAT' . IER.  'DK' . 0 ) 

DEFINE  FILE  1 ( 256. 256.  U.  NP ) 

CALL  SETFIL(2» 'HGH  DAT'. IRR. 'DK'. 0) 

DEFINE  FILE  2( 400. 36. U. NL ) 

0007 

oooa 

0009 

0010 
001 1 
0012 

RAD=0.  017453292519943 
RAD=RAD*5.  0 
READ ( 6. 6)LIM. LIN 

6 

FORMAT (213) 

DO  10  N=l. 36 
ANG=RAD*FLOAT ( N- 1 ) 

0013 

R 1 (N)=COS( ANG) 

0014 

R2 ( N ) =S I N ( ANG ) 

0015 

10 

CONTINUE 

0016 

DO  1 1 = 1.400 

0017 

READ (2'  I ) ( IPA(  I.  J),  J»l.  36) 

0018 

1 

CONTINUE 

0019 

T HR=FLOAT (LIM) 

0020 

I Y=0 

0021 

DO  2 1=1. 253 

0022 

IY=I Y+2 

0023 

READ ( 1 ' I ) I A 

0024 

11=1+1 

0025 

READd'II  )IB 

0026 

11=11+1 

0027 

READd'II  )IC 

0028 

11=11+1 

0029 

READd'II)  ID 

0030 

I X=1023 

0031 

DO  3 J=  1 . 253 

0032 

I X= I X-2 

0033 

K1=IABS( IA( J)-ID(J+3) )+IABS( IA< J+3)~ID( J> ) 

0034 

K2= I ABS ( I A ( J+ 1 )-ID( J+2) ) + IABS(IB<  J+3 ) - 1 C ( J ) ) 

0035 

K3=IABS( IA( J+2)-ID( J+l ) )+IABS( IB( J)-IC( J+3) ) 

0036 

K4= I ABS ( IB (J+l )-IC( J+2) )+IABS( IB( J+2)-IC( J+l ) ) 

0037 

VALUE=FLGAT ( K 1 *K2 ) *FLOAT ( K3*K4 ) 

0038 

VALUE =SQRT ( VALUE ) 

0039 

VALUE=SQRT ( VALUE ) 

0040 

M ( J ) =0 

0041 

IF (VALUE  LE.  THR)  GO  TO  3 

0042 

M( J)=l 

0043 

CALL  FSTPNT( IX.  IY) 

0044 

3 

CONTINUE 

0045 

I X=508 

0046 

DO  4 J= 1 . 253 

0047 

I X=I X— 2 

0043 

I F ( M ( J ) . EQ  O)  GO  TO  4 

0049 

T 1 =FLOAT ( J ) 

0050 

T 2=FLQAT ( 254— I ) 

0051 

DO  7 N=1 . 36 

0052 

LINE=T 1 *R 1 (N)+T2*R2(N) 

0053 

LINE=(LINE+401 )/2 

0054 

I F ( I PA  (LI  NE , N ) . LE.  LIN)  GO  TO  7 

0055 

CALL  FSTPNT( IX. 1Y> 

Inage  program  #5  continued. 

0056  GO  TO  4 

0057  7 CONTINUE 

0058  4 CONTINUE 

0059  2 CONTINUE 

0060  CALL  EXIT 

0061  END 

ROUTINES  CALLED: 
SETFIL.  FLOAT  . COS 
EXIT 


. SIN  . I ABS  . SORT  , FSTPNT 


OPTIONS  -/OP: 2 

BLOCK  LENGTH 

MAIN  32334  (176234)* 

♦♦COMPILER  CORE** 

PHASE  USED  FREE 

DECLARATIVES  00622  15026 
EXECUTABLES  01183  14465 
ASSEMBLY  01479  18809 


Image  Program  #6 

To  plot  the  original  gradient  picture  histogram  on  the  screen  of  key-board. 


0001 

0002 

0003 

0004 

0005 

0006 

0007 

0008 

0009 

0010 
OOl  1 
0012 

0013 

0014 

0015 

0016 

0017 

0018 
0019 


DIMENSION  I A ( 1 50 ) . I B ( 1 50 ) < HST ( 300 ) 

CALL  SETFIL ( 1 » 'TEN.  TEN',  IER.  'DK'.  U) 

DEFINE  FILE  1 ( 128. 150. U. NP) 

DO  6 1 = 1 . 300 
HST  ( I ) — O.  O 
READ(1'1)IA 
DO  2 1*2.  128 
READ ( 1 ' I ) I B 
DO  3 J-l.  149 

KK=IABS( IA(J>— IB< J+1))+IABS( IA(J*1 >-IB(J) ) 
KK-KK+1 

HST ( KK ) —HST ( KK ) -M . O 
CONTINUE 
DO  5 J-l.  150 
IA< J)*IB( J) 

CONT I NUE 

CALL  HSKHST.  300) 

CALL  EXIT  _________ 

END 


ROUTINES  CALLED: 
SETFIL.  I ABS  . COPY 


EXIT 


OPTIONS  -/OP: 2 


BLOCK  LENGTH 

MAIN.  1441  (005502)* 

♦•COMPILER  CORE** 

PHASE  USED  FREE 

DECLARATIVES  00622  15026 
EXECUTABLES  00863  14785 
ASSEMBLY  01091  19197 


0001 

0002 

0003 

0004 

0005 

0006 

0007  3 

0008 

0009 

0010 


DIMENSION  At  16) 

CALL  SETFILt  1 . 'QXF.  FAT'.  IE.  'DK'.O) 
DEFINE  FILE  1 ( 1075. 32. U. NL ) 

DO  3 J-l.  1075 
READ< 1 ' J ) A 
WRITE ( 3 ) A 
CONTINUE 
END  FILE  3 
CALL  EXIT 
END 


ROUTINES  CALLED: 
SETFIL.  EXIT 


Image  Program  #7 
Transfer  of  data 
from  disk  to  the 
tape. 


OPTIONS  “/OP: 2 

BLOCK  LENGTH 

MAIN  139  (000426)* 

** COMPILER  CORE** 

PHASE  USED  FREE 

DECLARATIVES  00622  15026 
EXECUTABLES  00783  14865 
ASSEMBLY  00959  19329 


0001 

0002 

0003 

0004 

0005 

0006 

0007 

0008  6 

0009 

0010 

OOl  1 1 

0012 

0013 

0014 

0015 

0016 

0017  3 

0018 

0019  2 

0020 
0021 


DIMENSION  IA( 1024). IB( 150) 

COMMON  /SWITCH/NO,  Nl.  N2.  N3.  N4,  N5.  N6. N7.  N8. N9. NIO. Nil. N12. N13. N14 
CALL  SSWTCHt 14. N14) 

IF(N14  EQ  2)  REWIND  1 

CALL  SETFILt  1.  'TEM.  TEN'.  IER,  'DK'.O) 

DEFINE  FILE  1 ( 1 28.  1 50.  U.  NP  ) 

READ<6. 6 ) J1 » II 
FORMAT ( 213 ) 

DO  1 1=1.11 

CALL  READUNt I A.  NPT ) 

CONTINUE 
DO  2 1 = 1.  128 


CALL  INPUT ( I A.  NPT) 

DO  3 J-l.  150 

JJ=J+J1 

IB(J)=IA( J J ) 

CONTINUE 

WRITE (I'D  IB 

CONTINUE 

CALL  EXIT 

END 


Image  Program  #8 
Transfer  of  data 
from  tape  to  disk. 


ROUTINES  CALLED: 

SSWTCH.  SETFIL.  READUN.  INPUT  , EXIT 
OPTIONS  -/OP: 2 


BLOCK  LENGTH 

MAIN.  2554  (011764)* 

SWITCH  30  (000074) 

♦♦COMPILER  CORE** 

PHASE  USED  FREE 

DECLARATIVES  00622  15026 
EXECUTABLES  01046  14602 
ASSEMBLY  01148  19140 


\ 


Image  Program  #9 

8-level  line-printer  plot.  K(7)  corresponds  to  7 boundary  1 evels( thresholds ) 
needed  to  requartize  256  levels  to  8 levels  for  line-printer  display  of 
shaded  portion  as  shovn. 


OOOl 

DIMENSION  I A( 130) . 1 B ( 8) . LINE ( 130 > > K(7) 

0002 

DATA  IB/'  'O'.  'X',  '•'/ 

0003 

CALL  SETFIL (2. 'CRD  DAT'. I ERR. "DK". 0) 

0004 

DEFINE  FILE  2 ( 100.  260.  U. L IN ) 

0003 

READ<6. 3 >L 1 > L2 

0006 

3 

FORMAT (213) 

0007 

READ <6.  2>K 

0008 

2 

FORMAT (713) 

0009 

DO  4 1*1 . LI 

OOIO 

READ(2'I >IA 

OOl  1 

WR I TE ( 5.  8) 

0012 

8 

FORMAT (IX) 

0013 

DO  5 J-2.  8 

0014 

DO  6 L-l. L2 

0015 

LINE ( L ) *1 B( 1 ) 

0016 

I F ( I A ( L ) — K ( J—  1 ) ) 6.  7.  7 

0017 

7 

LINE (L)»IB(J) 

0018 

6 

CONTINUE 

0019 

WR I TE ( 5.  9 )L INE 

0020 

9 

FORMAT ( 130A1 ) 

0021 

5 

CONTINUE 

0022 

4 

CONTINUE 

0023 

CALL  EXIT 

0024 

END 

ROUTINES  CALLED: 

SETFIL. 

EXIT 

OPTIONS 

=/0P: 2 

BLOCK 

LENGTH 

MAIN. 

804  (003110)* 

•♦COMPILER  CORE** 

PHASE  USED  FREE 

DECLARATIVES  00622  15026 


EXECUTABLES  00863  14783 
ASSEMBLY  01131  19137 


Image  Program  #10 


5-level  line  printer  display  of  modified  gradient  picture  for  picture 
segment  stored  in  disk. 


-2  _ 


8 


6 


. 7 
10 

_9 


5 


3 

4 


DIMENSION  IA< 128).  IB( 128).  IC< 128).  ID< 128).  IR< 123).  K<3> 
BYTE  IP<5). LINE( 125) 

INTEGEIR  IR ( 1 25 ) 

DATA  IP/'  'M's  'O'.  'X'/ 

CALL  SETF IL  < 2.  FI2  DAT', IERR.  DK',0> 

DEFINE  FILE  2(65. 123. U. LIN) 

READ  (6.  2 ) K 
FORMAT (31 3) 

READ (2' 1 ) I A 
READ ( 2'2 ) IB 

READ ( 2 ' 3 ) I C 

DO  4 ]=4,  65 
READ  (2'  DID 

WR I TE  ( 5,  8 ) 

FORMAT ( IX) 

DO  6 L.=  l.  125 

K1  = IA£!S<  IA(L)-ID(L+3)  ) + IABS(  IA(L+3)-ID<L)  ) 

K2=IAEiS<  IA(L+1  )-ID(L+2)  ) + IABS<  IB(L+3)-IC(L> ) 

K3=IAE:S<  IA(L+2)-ID(L+l  ) ) + IABS(  IC(L+3)-IB(L)  ) 

K4=IAEiS(  IBCL+1  )-IC(L+2)  ) + IABS(  IB(L+2)-IC(L+l  ) ) 

VALUE  3:FL0AT  ( K1*K2  ) *FLOAT  ( K3*K4  ) 

VALUE=>=SQRT  ( VALUE  ) 

IR  ( L ) 3!SQRT  ( VALUE  ) 

CONTINUE 
DO  10  L= 1 , 125 
LINE  (1.)  = IP(  1 ) 

DO  10  J=2.  4 

IF ( I R < L ) -K ( J— 1 ) ) 10.  10. 7 
L I N£  ( L ) = I P ( J ) 

CONTINUE 

WR I TE ( 5. 9 ) L I NE 

FORMAT 4X. 125A1 ) 

DO  5 J=l. 125 

I F ( L I NE ( J ) . EQ  IP( 4 ) ) LINE ( J)=IP<5> 

IFlLINE(J)  NE.  IP ( 5 ) ) LINE(J)=IP(1) 

CONTINUE 
WR I TE  < 5, 9 ) L I NE 
DO  3 J=l, 128 
I A ( J ) 3=  I B ( J ) 

IB(J)3tIC(J) 

IC(J)«ID(J) 

CONTINUE 
CALL  EXIT 

END  


DIMENSION  A<8.  9.  9).  IA< 1024), IB( 1024). L(7) 

COMMON  /SWITCH/NO.  Nl.  N2,  N3.  N4.  N5,  N6.  N7,  N8,  N9.  NIO,  N1 1 . N1 2 , N1 3,  N14 
CALL  SSWTCH ( 14.  Nl 4 ) 

IF  (N14  EQ.  2)  REWIND  1 

CALL  SETF IL ( 2,  COL  TEM", IE. 'DK'.O) 

DEFINE  FILE  2 ( 64, 1 28. U. NN ) 

ISUB=0 
LINE=0 
INTERV= 1 28 
READ (6,  999 )L 
FORMAT (713) 

DO  1 1 = 1,8 
DO  1 J= 1 , 9 

DO  1 K=l,  9 , 

A<  I.  J,  K)=0  O 

LINE=LIN£+1 

CALL  INPUT (I A.  NPT) 

LL=0 

DO  50  1=1. 8 

K 2=9  


DO  51  J=l.  128 

LL=LL+1 

N=IA(LL) 

CALL  LEVEL(N.  L.  7.  K1  ) 

A<  I.  K2.  K1  >»A(  I.  K2,  K1  ) + l.  O 

K2=K1 

CONTINUE 

CONTINUE 

IF (LINE  EQ.  INTERV)  GO  TO  39 
CALL  INPUT( IB.  NPT) 

11=0 
kC=0 
INTERH=0 
GO  TO  12 

A(KC.  Kl.  K2)=A(KC.  Kl.  K2)+l.  O 

IF (II.  EQ.  1024)  GO  TO  37 

11=11+1 

K3=9 

K4=9 

N=I A( II) 

KC=KC+ 1 

I NTERH= I NTERH+ 1 28 
I F ( N— L ( 1 ) ) 26,  19.  19 


Image  Program  #11 
This  program  computes 
the  co-occurrence  matrix 
of  a 102^xl02U  picture. 


A 7 

20 

21 

22 

23 

24 

25  

ir  1 v j.  i 

IF ( N-L ( 3 ) 
IF ( N-L ( 4 ) 
IF ( N-L ( 5 ) 
IF  ( N— L ( 6 ) 
IF (N— L ( 7 ) 
Kl=8 

26 

GO  TO  33 
Kl  = l 

GO  TO  33 

27 

Kl=2 

GO  TO  33 

28 

Kl=3 

GO  TO  33 

29 

K 1 =4 

. GO  TO  33 

30 

Kl»5 

GO  TO  33 

31 

K 1 =6 

GO  TO  33 

32 

Kl  = 7 

33 

N1=I£( II) 

M fc> 


37 

38 

39 


40 


100 


IF (Nl— L<  1 ) >68.  61.61 
IF(N1-L(2>  >69.  62,  62 
1 F ( N 1 — L ( 3 ) >70.  63.  63 
IF  < Nl-L ( 4 ) >71. 64. 64 
IF (Nl-L(5) >72. 65. 65 
IF ( Nl — L < 6 ) >73, 66.  66 
IF  (Nl-L(  7 ) ) 74.  67.  67 
k 2-3 

GO  TO  75 
K2=l 

GO  TO  75 

K2 =2  

GO  TO  75 
K2=3 
GO  TO  75 
K2=4 

GO  TO  75 

K2=5  

GO  TO  75 
K2=6 

GO  TO  75 
K2=7 

A(kC.  K4,  K1  >=A(KC.  K4.  K1  >4-1.  O 

A(kC.  k4,  K2)=A(KC.  K4.  K2)  + l.  O 

A ( KC.  K4,  K3)=A(KC.  K4.  K3>  + 1.  O 

A<  KC.  k3.  K2)=A(KC.  K3.  K2)  + l.  O 

IFCII.EQ.  1NTERH)  GO  TO  17 

k3=Kl 

k4=k2 

II=II+1 

N=I A( II) 

GO  TO  18 
DO  38  1*1. 1024 
I A ( I )*IB( I ) 

LINE=LINE+1 

GO  TO  16  

DO  40  1*1,8 
I SUB*  I SUE; -*-1 

WRITE(2'ISUB)  ( (A(1.J,K)<  K*l.  8).  J=l»  8) 
CONTINUE 

INTERV=INTERV+128 

IF  (LINE.  GE.  1024 > GO  TO  lOO 

GO  TO  14 

CALL  EXIT 

END 


i 

I 


5 

6 


DIMENSION  A(  8. 8 ) . B < 64 ) 

DEFINE  FILE  1 (64, 128, U, MM) 

READ (6. 5) IFILE 
FORMAT ( 12) 

WRITE(5, 6 ) IFILE 

FORMAT  (3X.  •'FILE  NUMBER-'.  2X»  12) 

DO  1 I = 1 . 64 

READ ( 1I)A 

SUM=0  O 

DO  2 0=1. 8 

DO  3 k=l , 8 

TEM=FLOAT < I ABS ( J-K  > ) 

SUM=SUM>TEM*TEM*TEM*ALOG(A(K.  J)+A<  J.  K>4-1. 


Image  Program  #12 
This  program  tabulates 
the  texture  measure 

21 ZZU-;  I 

in  8x8  array. 

0) 


CONTINUE 


CONTINUE 


B<  I >*SUM 
1 CONTINUE 

WR I TE ( 5,  4>B 

4 FORMAT  ( (3X,  8<  IX,  IPEIO.  3 > > > 

_ ..  END 
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